unit uGEDA ;

interface

uses
   Windows,
   Messages,
   SysUtils,
   Variants,
   Classes,
   Graphics,
   Controls,
   Forms,
   Dialogs,
   Contnrs,
   uBasic,
   uObjects,
   uPlacement,
   uViewSchematic,
   uViewPCB,
   SpTBXTabs,
   TB2Item,
   TBX,
   SpTBXItem,
   SpTBXControls,
   VirtualTrees,
   StdCtrls,
   SpTBXEditors,
   VirtualShellUtilities,
   VirtualExplorerTree,
   GDIPAPI
   ;

type
   TgEDAType = ( ttNone, ttKeyword, ttID, ttINT, ttSTRING, ttCOMMENT,
      ttAPOST, ttADD, ttSUB, ttAND, ttXOR,
      ttIOR, ttSMT, ttGRT, ttAT, ttEQ, ttSLASH,
      ttBRACE_CLOSE, ttBRACE_OPEN,
      ttBRACKET_CLOSE, ttBRACKET_OPEN,
      ttRBRACKET_CLOSE, ttRBRACKET_OPEN,
      ttCOLON, ttCOMMA, ttDOT, ttHASH,
      ttMOD, ttMUL, ttNOT, ttQMARK, ttPERCENT,
      ttSEMI,
      ttNL, ttEOF
      ) ;

type
   TgEDAKeyword = (
      tkNone,
      tkVersion, tkLine, tkGraphic, tkBox,
      tkCircle, tkArc, tkText, tkNet,
      tkBus, tkPin, tkComponent, tkFont
      ) ;

type
   TgEDAToken = class
   private
      function GetAsInt : integer ;
      function GetAsKeyword : TgEDAKeyword ;
      function GetAsFloat : extended ;
      function GetAsString : string ;
   public
      aType : TgEDAType ;
      aValue : Variant ;
      aLine : integer ;
      aIdent : string ;
      property AsInt : integer read GetAsInt ;
      property AsFloat : extended read GetAsFloat ;
      property AsString : string read GetAsString ;
      property AsKeyword : TgEDAKeyword read GetAsKeyword ;
   end ;

type
   TfrmGEDA = class( TFrame )
      vetGEDA : TVirtualExplorerTreeview ;
      procedure vetgEDATreeDblClick( Sender : TCustomVirtualExplorerTree ;
         Node : PVirtualNode ; Button : TMouseButton ; Point : TPoint ) ;
      procedure vetgEDAEnumFolder( Sender : TCustomVirtualExplorerTree ;
         Namespace : TNamespace ; var AllowAsChild : Boolean ) ;
   private
      { Private declarations }
      fFile : TStringlist ;

      fProject : TMedaProject ;
      fModule : TMedaModule ;
      fPage : TMedaPage ;

      fCurrent : integer ;

      procedure ParseNet ;
      procedure SetProject( const Value : TMedaProject ) ;

   private
      function Current : TgEDAToken ;
      function Next : TgEDAToken ;
      procedure Eat ;
      function IsNotNL : boolean ;
      procedure SkipNL ;
   public
      { Public declarations }
      constructor Create( AOwner : TComponent ) ; override ;
      destructor Destroy ; override ;

      property Project : TMedaProject read FProject write SetProject ;
      procedure Lex( const aFilename : string ) ;
      procedure Parse ;
   end ;

implementation

var
   fTokens          : TObjectlist ;
   fKeywords        : TStringlist ;
   fSymbols         : TStringlist ;

{$R *.dfm}

   (*
   All coords are in mils
   Origin is in lower left hand corner.

      ^
    ^ |
    | |
    y |
      +-------->
    0,0  x->

   Type must start in column one (for now).

   Components:

   C 18600 19900 1 0 0 68K_reset.sym

    type x y selectable angle mirror basename

    type = C
    x y = location of corner point
    selectable = 1 if selectable or 0 if not
    angle = rotation, 0, 90, 180, 270 (only)
    mirror = 0 if no mirrored or 1 if mirrored
    basename = component name, does not include any path!

   Text:

   T 16900 35800 3 10 1 0 0
   I'm a string!

    type x y color size visibility show_name_value angle
    string

    type = T
    x y = same as above
    color = see include/colors.h
    visibility = 0 if invisible or 1 if visible
    show_name_value = show both name and value 0
        show value only 1
        show name only 2
    angle = rotation, 0, 90, 180, 270 (only)
    string = text string

   Net:
   Line:
   Pin:

   N 12700 29400 32900 29400 4
   L 27300 37400 37200 35300 3
   P 17800 33100 22300 33100 -1

    type x1 y1 x2 y2 color

    type = (N L P)
    x1 y1 = first point
    x2 y2 = second point
    color = see include/colors.h

    (why is pin color -1? that's a bug, that I really should fix. :-)
    (add to the bugslist, this bug is a left over one from early days)

   Arc:

   A 0 500 400 -48 97 3

    type x y radius start_angle sweep_angle color

    type = A
    x y = center of arc
    radius = radius of arc
    start_angle = starting angle in degrees
    sweep_angle = degrees to sweep arc
    color = see include/colors.h

   Box:

   B 300 300 1400 2900 3

    type x y width height color

    type = B
    x y = lower left hand corner
    width height = width and height of the box
    color = see include/colors.h

   Circle

   V 250 700 49 6

    type x y radius color

    type = V
    x y = center of circle
    radius = radius of the circle
    color = see include/colors.h

   Attributes are enclosed in { } and can only be text.  Attributes are text
   items which take on the form name=value.  If it doesn't have name=value
   it's not an attribute.  Attributes are attached to the previous object.
   Here's an example:

   P 988 500 1300 500 1
   {
   T 1000 550 5 8 1 1 0
   pin3=3
   }

    The object is a pin which has an attribute pin3=3 (name=value).
   You can have multiple text items in between the { }

   Embedded objects have the form:

   C 18600 21500 1 0 0 EMBEDDED555-1.sym
   [
   ...
   ... Embedded primative objects
   ...
   ]

   Where the basename is EMBEDDEDcomponent_name.sym
   component_name.sym must exist in one of the specified component-libraries
   if you want to unembed a component.

   *)
   { TfrmGEDA }

constructor TfrmGEDA.Create( AOwner : TComponent ) ;
begin
   inherited ;
   fFile := TStringlist.Create ;

   fSymbols := TStringlist.Create ;
   fSymbols.CaseSensitive := True ;
   fSymbols.Sorted := False ;

   fKeywords := TStringlist.Create ;
   fKeywords.CaseSensitive := True ;
   fKeywords.Sorted := True ;

   fTokens := TObjectlist.Create( True ) ;
   fCurrent := 0 ;

   vetgEDA.Active := True ;
   vetgEDA.BrowseTo( 'C:\Projects' ) ;

   fKeywords.AddObject( 'v', TObject( tkVersion ) ) ;
   fKeywords.AddObject( 'L', TObject( tkLine ) ) ;
   fKeywords.AddObject( 'G', TObject( tkGraphic ) ) ;
   fKeywords.AddObject( 'B', TObject( tkBox ) ) ;
   fKeywords.AddObject( 'V', TObject( tkCircle ) ) ;
   fKeywords.AddObject( 'A', TObject( tkArc ) ) ;
   fKeywords.AddObject( 'T', TObject( tkText ) ) ;
   fKeywords.AddObject( 'N', TObject( tkNet ) ) ;
   fKeywords.AddObject( 'P', TObject( tkPin ) ) ;
   fKeywords.AddObject( 'C', TObject( tkComponent ) ) ;
   fKeywords.AddObject( 'F', TObject( tkFont ) ) ;
end ;

function TfrmGEDA.Current : TgEDAToken ;
begin
   Result := nil ;
   if fCurrent < fTokens.Count then
      Result := TgEDAToken( fTokens[ fCurrent ] ) ;
end ;

function TfrmGEDA.Next : TgEDAToken ;
begin
   Result := nil ;
   if fCurrent < fTokens.Count then begin
      Result := TgEDAToken( fTokens[ fCurrent ] ) ;
      inc( fCurrent ) ;
   end ;
end ;

destructor TfrmGEDA.Destroy ;
begin
   vetgEDA.Active := False ;
   fKeywords.Free ;
   fSymbols.Free ;
   fTokens.Free ;
   fFile.Free ;
   inherited ;
end ;

procedure TfrmGEDA.Eat ;
begin
   inc( fCurrent ) ;
end ;

function TfrmGEDA.IsNotNL : boolean ;
begin
   Result := ( Current <> nil ) and ( Current.aType <> ttNL ) ;
end ;

procedure TfrmGEDA.SkipNL ;
begin
   while Current <> nil do
      if Next.aType = ttNL then begin
         Exit ;
      end ;
end ;

procedure TfrmGEDA.Parse ;
var
   iX1, iY1, iX2, iY2 : extended ;
   i, iDate, iFormat, iwidth, iheight, icolor, ilinewidth, iradius, icapstyle,
      idashstyle, idashlength, isize, idashspace, ifilltype, ifillwidth,
      iangle1, ipitch1, iangle2, ipitch2, istartangle, isweepangle,
      iSel, iAngle, iMirror, ivisibility, ishow_name_value, iripperdir,
      ilines, ialignment, ipintype, iwhichend, imirrored, iembedded : integer ;
   iFilename, iSymbol : string ;
   iBank            : TMedaBank ;
   iNet             : TMedaNet ;
   iLine            : TMedaWire ;
   iTrans           : TMedaTransform ;
begin
   if assigned( fProject ) then begin
      fPage := vsbSchematicViewer.AddPage ;
      fPage.Name := 'gEDA' ;
      fModule := fProject.NewModule ;
      fModule.Name := 'gEDA' ;
      iTrans.Position := MakePoint( 0.0, 0.0 ) ;
      iTrans.Rotation := integer(drEast) * 45 ;
      iTrans.Mirror := False ;
      while fCurrent < fTokens.Count do begin
         case Current.aType of
            ttKeyword : case Current.AsKeyword of
                  // v 20040111 1
                  tkVersion : begin
                        Eat ;
                        iDate := Next.AsInt ;
                        iFormat := Next.AsInt ;
                        SkipNL ;
                     end ;
                  // L 23000 69000 28000 69000 3 40 0 1 -1 75
                  tkLine : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iX2 := Next.AsFloat ;
                        iY2 := Next.AsFloat ;
                        icolor := Next.AsInt ;
                        iwidth := Next.AsInt ;
                        icapstyle := Next.AsInt ;
                        idashstyle := Next.AsInt ;
                        idashlength := Next.AsInt ;
                        idashspace := Next.AsInt ;
                        SkipNL ;
                     end ;
                  // G 16900 35800 1400 2175 0 6.435331e-01 0 0
                  // ../bitmaps/logo.jpg
                  tkGraphic : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iwidth := Next.AsInt ;
                        iheight := Next.AsInt ;
                        iangle := Next.AsInt ;
                        imirrored := Next.AsInt ;
                        iembedded := Next.AsInt ;
                        iFilename := Next.AsString ;
                        SkipNL ;
                     end ;
                  // B 33000 67300 2000 2000 3 60 0 2 75 50 0 -1 -1 -1 -1 -1
                  tkBox : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iwidth := Next.AsInt ;
                        iheight := Next.AsInt ;
                        iColor := Next.AsInt ;
                        ilinewidth := Next.AsInt ;
                        icapstyle := Next.AsInt ;
                        idashstyle := Next.AsInt ;
                        idashlength := Next.AsInt ;
                        idashspace := Next.AsInt ;
                        ifilltype := Next.AsInt ;
                        ifillwidth := Next.AsInt ;
                        iangle1 := Next.AsInt ;
                        ipitch1 := Next.AsInt ;
                        iangle2 := Next.AsInt ;
                        ipitch2 := Next.AsInt ;
                        SkipNL ;
                        //                        iBox:= fModule.AddBank ;
                        //                        iBox.Outline := MakeRect( iX1, iY1, iwidth, iheight ) ;
                     end ;
                  // V 38000 67000 900 3 0 0 2 75 50 2 10 20 30 90 50
                  tkCircle : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iradius := Next.AsInt ;
                        iColor := Next.AsInt ;
                        ilinewidth := Next.AsInt ;
                        icapstyle := Next.AsInt ;
                        idashstyle := Next.AsInt ;
                        idashlength := Next.AsInt ;
                        idashspace := Next.AsInt ;
                        ifilltype := Next.AsInt ;
                        ifillwidth := Next.AsInt ;
                        iangle1 := Next.AsInt ;
                        ipitch1 := Next.AsInt ;
                        iangle2 := Next.AsInt ;
                        ipitch2 := Next.AsInt ;
                        SkipNL ;
                     end ;
                  // A 30600 75000 2000 0 45 3 0 0 3 75 50
                  tkArc : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iradius := Next.AsInt ;
                        istartangle := Next.AsInt ;
                        isweepangle := Next.AsInt ;
                        iColor := Next.AsInt ;
                        iwidth := Next.AsInt ;
                        icapstyle := Next.AsInt ;
                        idashstyle := Next.AsInt ;
                        idashlength := Next.AsInt ;
                        idashspace := Next.AsInt ;
                        SkipNL ;
                     end ;
                  // T 16900 35800 3 10 1 0 0 0 1
                  // Text string!
                  tkText : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iColor := Next.AsInt ;
                        isize := Next.AsInt ;
                        ivisibility := Next.AsInt ;
                        ishow_name_value := Next.AsInt ;
                        iangle1 := Next.AsInt ;
                        ialignment := Next.AsInt ;
                        ilines := Next.AsInt ;
                        for i := 0 to ilines - 1 do begin
                           iSymbol := '' ;
                           while Current.aType <> ttNL do
                              iSymbol := iSymbol + ' ' + Next.AsString ;
                        end ;
                        SkipNL ;
                     end ;
                  // N 12700 29400 32900 29400 4
                  tkNet : begin
                        Eat ;
                        iX1 := Next.AsFloat / 20 - 3000 ;
                        iY1 := Next.AsFloat / 20 - 1500 ;
                        iX2 := Next.AsFloat / 20 - 3000 ;
                        iY2 := Next.AsFloat / 20 - 1500 ;
                        iColor := Next.AsInt ;
                        SkipNL ;
                        iNet := fModule.AddNet ;
                        iLine := iNet.AddWire ;
                        iTrans.Position := MakePoint( iX1, iY1 ) ;
                        iLine.AddStroke( MakePoint( 0.0, 0.0 ),
                           MakePoint( iX2 - iX1, iY2 - iY1 ) ) ;
                        iLine.PlaceRef := fPage.ID ;
                        iLine.Transforms[ 0 ] := iTrans ;
                        iLine.PlaceMe ;
                     end ;
                  // U 27300 37400 27300 35300 3 0
                  tkBus : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iX2 := Next.AsFloat ;
                        iY2 := Next.AsFloat ;
                        iColor := Next.AsInt ;
                        iRipperdir := Next.AsInt ;
                        SkipNL ;
                     end ;
                  // P 0 200 200 200 1 0 0
                  tkPin : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iX2 := Next.AsFloat ;
                        iY2 := Next.AsFloat ;
                        iColor := Next.AsInt ;
                        iPintype := Next.AsInt ;
                        iWhichend := Next.AsInt ;
                        SkipNL ;
                     end ;
                  // C 18600 19900 1 0 0 7400-1.sym
                  tkComponent : begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iSel := Next.AsInt ;
                        iAngle := Next.AsInt ;
                        iMirror := Next.AsInt ;
                        iSymbol := Next.AsString ;
                        SkipNL ;
                     end ;
                  tkFont : begin
                        Eat ;
                        SkipNL ;
                     end ;
               else
                  Eat ;
               end ;
            ttBRACE_OPEN : begin
                  // {
                  Eat ;
                  SkipNL ;
                  while ( Current <> nil ) and ( Current.aType <> ttBRACE_CLOSE ) do begin
                     // T 1000 570 5 8 1 1 0
                     // pinseq=3
                     // T 1000 550 5 8 1 1 0
                     // pinnumber=3
                     if ( Current <> nil ) and ( Current.AsKeyword = tkText ) then begin
                        Eat ;
                        iX1 := Next.AsFloat ;
                        iY1 := Next.AsFloat ;
                        iColor := Next.AsInt ;
                        isize := Next.AsInt ;
                        ivisibility := Next.AsInt ;
                        ishow_name_value := Next.AsInt ;
                        iangle1 := Next.AsInt ;
                        ialignment := Next.AsInt ;
                        ilines := Next.AsInt ;
                        SkipNL ;
                        iSymbol := Next.AsString ;
                        if ( Current <> nil ) and ( Current.aType = ttEQ ) then begin
                           Eat ;
                           iSymbol := '' ;
                           while IsNotNL do
                              iSymbol := iSymbol + Next.AsString ;
                        end ;
                     end
                     else
                        Eat ;
                     SkipNL ;
                  end ;
                  // }
                  SkipNL ;
               end ;
            ttNL : Eat ;
         else
            Eat ;
         end ;
      end ;
   end ;
end ;

procedure TfrmGEDA.ParseNet ;
begin
end ;

procedure TfrmGEDA.SetProject( const Value : TMedaProject ) ;
begin
   FProject := Value ;
end ;

procedure TfrmGEDA.vetgEDAEnumFolder( Sender : TCustomVirtualExplorerTree ;
   Namespace : TNamespace ; var AllowAsChild : Boolean ) ;
begin
   AllowAsChild := ( Namespace.FileType = 'sch' ) or
      Namespace.Directory or Namespace.Parent.Directory ;
end ;

procedure TfrmGEDA.vetgEDATreeDblClick( Sender : TCustomVirtualExplorerTree ;
   Node : PVirtualNode ; Button : TMouseButton ; Point : TPoint ) ;
var
   Namespace        : TNamespace ;
begin
   if Sender.ValidateNamespace( Node, Namespace ) then begin
      if not Namespace.Folder then begin
         Lex( Namespace.NameForParsing ) ;
         Parse ;
      end ;
   end ;
end ;

procedure TfrmGEDA.Lex( const aFilename : string ) ;
var
   iText            : string ;
   iType            : TgEDAType ;
   iLine            : integer ;
   iValue           : Variant ;
   iIdent           : string ;
   p, s             : PChar ;
   index            : integer ;
   bText            : boolean ;

   procedure AddToken ;
   var
      iToken        : TgEDAToken ;
   begin
      iToken := TgEDAToken.Create ;
      fTokens.Add( iToken ) ;
      iToken.aType := iType ;
      iToken.aValue := iValue ;
      iToken.aLine := iLine ;
      iToken.aIdent := iIdent ;
   end ;
begin
   fSymbols.Clear ;
   fFile.LoadFromFile( aFilename ) ;
   fCurrent := 0 ;
   iText := fFile.Text ;
   if iText = '' then
      Exit ;

   iLine := 1 ;
   p := @iText[ 1 ] ;
   s := p ;
   iType := ttNone ;
   try
      while P^ <> #0 do begin
         case iType of
            ttNone : begin
                  bText := P^ = 'T' ;
                  case P^ of
                     '_', '+', '-', '.', 'a'..'z', 'A'..'Z', '0'..'9' : begin
                           s := p ;
                           iType := ttID ;
                           inc( p ) ;
                        end ;
                     '"', '$' : begin
                           iType := ttSTRING ;
                           inc( p ) ;
                           s := p ;
                        end ;
                     ',' : iType := ttCOMMA ;
                     '%' : iType := ttPERCENT ;
                     ':' : iType := ttCOLON ;
                     '=' : iType := ttEQ ;
                     '/' : iType := ttSLASH ;
                     '{' : iType := ttBRACE_OPEN ;
                     '}' : iType := ttBRACE_CLOSE ;

                     ' ', #1..#9, #11, #12, #14..#31 : inc( p ) ; // whitespace
                     #13 : inc( p ) ;
                     #10 : begin
                           iType := ttNL ;
                           AddToken ;
                           inc( iLine ) ; // newline
                           inc( p ) ;
                           iType := ttNone ;
                        end ;
                  else
                     iType := ttNone ;
                     AddToken ;
                     Exit ;
                  end ;
               end ;

            ttID :
               case p^ of
                  '_', '+', '-', '.', 'a'..'z', 'A'..'Z', '0'..'9' : inc( p ) ;
               else
                  SetString( iIdent, s, p - s ) ;
                  index := fKeywords.IndexOf( iIdent ) ;
                  if index < 0 then begin
                     index := fSymbols.IndexOf( iIdent ) ;
                     if index < 0 then
                        iValue := fSymbols.Add( iIdent )
                     else
                        iValue := index ;
                  end
                  else begin
                     iType := ttKEYWORD ;
                     iValue := index ;
                  end ;
                  AddToken ;
                  iType := ttNone ;
               end ;

            ttSTRING :
               case p^ of
                  '"', '$' : begin
                        SetString( iIdent, s, p - s ) ;
                        index := fSymbols.IndexOf( iIdent ) ;
                        if index < 0 then
                           iValue := fSymbols.Add( iIdent )
                        else
                           iValue := index ;
                        AddToken ;
                        iType := ttNone ;
                        inc( p ) ;
                     end ;
                  #0..#31 : begin
                        iType := ttNone ;
                        AddToken ;
                        Exit ;
                     end ;
               else
                  inc( p ) ;
               end ;

            ttCOMMENT :
               if p^ = #10 then
                  iType := ttNone       // handle via #10 for line counting
               else
                  inc( p ) ;

            ttEQ,
               ttAND,
               ttIOR,
               ttXOR,
               ttADD,
               ttSUB,
               ttAT,
               ttSLASH,
               ttBRACE_CLOSE,
               ttBRACE_OPEN,
               ttBRACKET_CLOSE,
               ttBRACKET_OPEN,
               ttCOLON,
               ttCOMMA,
               ttDOT,
               ttHASH,
               ttMOD,
               ttMUL,
               ttNOT,
               ttQMARK, ttPERCENT,
               ttRBRACKET_CLOSE,
               ttRBRACKET_OPEN,
               ttSEMI : begin
                  AddToken ;
                  iType := ttNone ;
                  inc( p )
               end ;
         else
         end ;
      end ;
   finally
      iType := ttEOF ;
      AddToken ;
      Delete( iText, 1, p - @iText[ 1 ] ) ;
   end ;
end ;

{ TgEDAToken }

function TgEDAToken.GetAsInt : integer ;
begin
   Result := 0 ;
   if aType = ttID then
      Result := StrToIntDef( aIdent, 0 ) ;
end ;

function TgEDAToken.GetAsFloat : extended ;
begin
   Result := 0 ;
   if aType = ttID then
      Result := StrToFloatDef( aIdent, 0.0 ) ;
end ;

function TgEDAToken.GetAsKeyword : TgEDAKeyword ;
begin
   Result := tkNone ;
   if aType = ttKeyword then
      Result := TgEDAKeyword( fKeywords.Objects[ aValue ] ) ;
end ;

function TgEDAToken.GetAsString : string ;
begin
   Result := '' ;
   if aType = ttID then
      Result := fSymbols[ aValue ]
   else if aType = ttKeyword then
      Result := fKeywords[ aValue ] ;
end ;

end.

